home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / reports / filetrns / columns.frm < prev    next >
Text File  |  1995-11-12  |  8KB  |  318 lines
  1. VERSION 2.00
  2. Begin Form frmColumns 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Retrieve Field Descriptions"
  5.    ClientHeight    =   3090
  6.    ClientLeft      =   555
  7.    ClientTop       =   1695
  8.    ClientWidth     =   7365
  9.    Height          =   3495
  10.    Icon            =   COLUMNS.FRX:0000
  11.    Left            =   495
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   3090
  14.    ScaleWidth      =   7365
  15.    Top             =   1350
  16.    Width           =   7485
  17.    Begin OptionButton optMethod 
  18.       BackColor       =   &H00C0C0C0&
  19.       Caption         =   "Extract Columns"
  20.       Height          =   315
  21.       Index           =   1
  22.       Left            =   2640
  23.       TabIndex        =   3
  24.       Top             =   420
  25.       Width           =   1695
  26.    End
  27.    Begin OptionButton optMethod 
  28.       BackColor       =   &H00C0C0C0&
  29.       Caption         =   "Get Templates"
  30.       Height          =   315
  31.       Index           =   0
  32.       Left            =   2640
  33.       TabIndex        =   2
  34.       Top             =   120
  35.       Width           =   1695
  36.    End
  37.    Begin CommandButton cmdExit 
  38.       Caption         =   "E&xit"
  39.       Height          =   555
  40.       Left            =   5640
  41.       TabIndex        =   5
  42.       Top             =   120
  43.       Width           =   1095
  44.    End
  45.    Begin CommandButton cmdGet 
  46.       Caption         =   "Retrieve"
  47.       Height          =   555
  48.       Left            =   4440
  49.       TabIndex        =   4
  50.       Top             =   120
  51.       Width           =   1095
  52.    End
  53.    Begin TextBox txtFile 
  54.       Height          =   315
  55.       Left            =   1320
  56.       TabIndex        =   1
  57.       Top             =   360
  58.       Width           =   1215
  59.    End
  60.    Begin TextBox txtLibrary 
  61.       Height          =   315
  62.       Left            =   60
  63.       TabIndex        =   0
  64.       Top             =   360
  65.       Width           =   1215
  66.    End
  67.    Begin Grid grdFields 
  68.       Cols            =   10
  69.       FixedCols       =   0
  70.       FontBold        =   0   'False
  71.       FontItalic      =   0   'False
  72.       FontName        =   "MS Sans Serif"
  73.       FontSize        =   8.25
  74.       FontStrikethru  =   0   'False
  75.       FontUnderline   =   0   'False
  76.       Height          =   2235
  77.       Left            =   60
  78.       TabIndex        =   6
  79.       Top             =   780
  80.       Width           =   7215
  81.    End
  82.    Begin Label zlbl 
  83.       Alignment       =   2  'Center
  84.       BackColor       =   &H00800000&
  85.       Caption         =   "File"
  86.       ForeColor       =   &H00FFFFFF&
  87.       Height          =   255
  88.       Index           =   1
  89.       Left            =   1320
  90.       TabIndex        =   8
  91.       Top             =   120
  92.       Width           =   1215
  93.    End
  94.    Begin Label zlbl 
  95.       Alignment       =   2  'Center
  96.       BackColor       =   &H00800000&
  97.       Caption         =   "Library"
  98.       ForeColor       =   &H00FFFFFF&
  99.       Height          =   255
  100.       Index           =   0
  101.       Left            =   60
  102.       TabIndex        =   7
  103.       Top             =   120
  104.       Width           =   1215
  105.    End
  106. End
  107. Option Explicit
  108.  
  109.   ' Variables:
  110.   Dim asFieldType(0 To 15) As String     ' field type descriptions
  111.  
  112. Sub cmdExit_Click ()
  113.  
  114.   ' end program
  115.   Unload Me
  116.  
  117. End Sub
  118.  
  119. Sub cmdGet_Click ()
  120.  
  121.  ' Description:
  122.  '  Reset grid, retrieve templates, and place field
  123.  '  information into grid.
  124.  
  125.  ' Variables:
  126.   Dim bNum        As Integer       ' field type numeric flag
  127.   Dim iCnt        As Integer       ' loop counter
  128.   Dim nFields     As Integer       ' number of fields found
  129.   Dim sTmp        As String        ' work field
  130.  
  131.   ' AS/400 file column information
  132.   ReDim atCols(1 To 500) As TFColType
  133.  
  134.   ' hourglass
  135.   MousePointer = HOURGLASS
  136.   
  137.   ' reset grid
  138.   grdFields.Rows = 2
  139.   grdFields.FixedRows = 1
  140.  
  141.   ' if using get template method then
  142.   If optMethod(0) Then
  143.  
  144.     ' get field templates
  145.     nFields = zzTFGetTemplatesAll(Me.hWnd, zzCAGetDefaultSystem(Me.hWnd), txtLibrary, txtFile, atCols())
  146.  
  147.   ' if using extract columns method
  148.   Else
  149.   
  150.     ' get column information
  151.     nFields = zzTFGetColumnsAll(Me.hWnd, zzCAGetDefaultSystem(Me.hWnd), txtLibrary, txtFile, atCols())
  152.   
  153.   End If
  154.   
  155.   ' if no templates found
  156.   If nFields = 0 Then
  157.     
  158.     ' tell user of error
  159.     MsgBox "No field descriptions found for " & UCase$(txtLibrary) & "/" & UCase$(txtFile) & "."
  160.  
  161.   Else
  162.     
  163.     ' add templates to grid
  164.     For iCnt = 1 To nFields
  165.  
  166.       ' start with field name
  167.       sTmp = atCols(iCnt).sName & gsCHR_TAB
  168.       
  169.       ' add text description of type of field
  170.       sTmp = sTmp & asFieldType(atCols(iCnt).nType) & gsCHR_TAB
  171.       
  172.       ' add buffer length of field
  173.       sTmp = sTmp & Str$(atCols(iCnt).nLen) & gsCHR_TAB
  174.  
  175.       ' add number of digits
  176.       If atCols(iCnt).nDigits <> 0 Then
  177.         
  178.         sTmp = sTmp & Str$(atCols(iCnt).nDigits) & gsCHR_TAB
  179.  
  180.         ' if binary, zoned, or packed then
  181.         bNum = (atCols(iCnt).nType = gnTF_BINARY_FIELD)
  182.         bNum = bNum Or (atCols(iCnt).nType = gnTF_ZONED_FIELD)
  183.         bNum = bNum Or (atCols(iCnt).nType = gnTF_PACKED_FIELD)
  184.         If bNum Then
  185.         
  186.           ' add in number of decimals
  187.           sTmp = sTmp & Str$(atCols(iCnt).nDecPos) & gsCHR_TAB
  188.   
  189.         ' else add nothing
  190.         Else
  191.           sTmp = sTmp & gsCHR_TAB
  192.         End If
  193.  
  194.       Else
  195.         sTmp = sTmp & gsCHR_TAB & gsCHR_TAB
  196.       End If
  197.       
  198.       ' is field null capable
  199.       If atCols(iCnt).bNullCap Then
  200.         sTmp = sTmp & "Yes" & gsCHR_TAB
  201.       Else
  202.         sTmp = sTmp & gsCHR_TAB
  203.       End If
  204.  
  205.       ' is field variable length
  206.       If atCols(iCnt).bVarLen Then
  207.         sTmp = sTmp & "Yes" & gsCHR_TAB
  208.       Else
  209.         sTmp = sTmp & gsCHR_TAB
  210.       End If
  211.  
  212.       ' add description
  213.       sTmp = sTmp & atCols(iCnt).sText
  214.  
  215.       ' add to grid
  216.       grdFields.AddItem sTmp, grdFields.Rows - 1
  217.  
  218.     Next iCnt
  219.     
  220.     ' remove last record which is empty
  221.     On Error Resume Next
  222.     grdFields.RemoveItem grdFields.Rows - 1
  223.     
  224.   End If
  225.            
  226.   ' no more hourglass
  227.   MousePointer = DEFAULT
  228.   grdFields.SetFocus
  229.  
  230. End Sub
  231.  
  232. Sub Form_Load ()
  233.  
  234.   ' set global character constants
  235.   Call zzSetGlobalVariables
  236.  
  237.   ' set application title
  238.   App.Title = Caption
  239.  
  240.   ' setup text descriptions for field types
  241.   asFieldType(0) = "Hexadecimal"
  242.   asFieldType(1) = "Binary"
  243.   asFieldType(2) = "Character"
  244.   asFieldType(3) = "Zoned"
  245.   asFieldType(4) = "Packed"
  246.   asFieldType(5) = "Reserved"
  247.   asFieldType(6) = "IGC Open"
  248.   asFieldType(7) = "IGC Only"
  249.   asFieldType(8) = "IGC Either"
  250.   asFieldType(9) = "Undefined"
  251.   asFieldType(10) = "Undefined"
  252.   asFieldType(11) = "Time"
  253.   asFieldType(12) = "Date"
  254.   asFieldType(13) = "Timestamp"
  255.   asFieldType(14) = "Undefined"
  256.   asFieldType(15) = "Graphic"
  257.  
  258.   ' setup option default to templates
  259.   optMethod(0).Value = True
  260.  
  261.   ' format grid
  262.   grdFields.Rows = 2
  263.   grdFields.FixedRows = 1
  264.   grdFields.Cols = 8
  265.  
  266.   ' build headings
  267.   grdFields.Row = 0
  268.   grdFields.Col = 0
  269.   grdFields.Text = "Name"
  270.   grdFields.ColWidth(0) = 1035
  271.  
  272.   grdFields.Col = 1
  273.   grdFields.Text = "Type"
  274.   grdFields.ColWidth(1) = 1035
  275.  
  276.   grdFields.Col = 2
  277.   grdFields.Text = "Size"
  278.   grdFields.ColWidth(2) = 390
  279.  
  280.   grdFields.Col = 3
  281.   grdFields.Text = "Digits"
  282.   grdFields.ColWidth(3) = 450
  283.   
  284.   grdFields.Col = 4
  285.   grdFields.Text = "Decimals"
  286.   grdFields.ColWidth(4) = 720
  287.  
  288.   grdFields.Col = 5
  289.   grdFields.Text = "Null Capable?"
  290.   grdFields.ColWidth(5) = 1065
  291.  
  292.   grdFields.Col = 6
  293.   grdFields.Text = "Variable Length?"
  294.   grdFields.ColWidth(6) = 1275
  295.  
  296.   grdFields.Col = 7
  297.   grdFields.Text = "Description"
  298.   grdFields.ColWidth(7) = 5000
  299.  
  300. End Sub
  301.  
  302. Sub Form_Resize ()
  303.  
  304.   ' handle resize of grid width and height
  305.   On Error Resume Next
  306.   grdFields.Width = ScaleWidth - (grdFields.Left * 2)
  307.   grdFields.Height = ScaleHeight - grdFields.Top - 60
  308.  
  309. End Sub
  310.  
  311. Sub Form_Unload (Cancel As Integer)
  312.  
  313.   ' end program
  314.   End
  315.  
  316. End Sub
  317.  
  318.